COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGOF("BLOCK")
C00004 00003	PUBLIC SIMPLE PROCEDURE BLOCK! $"#
C00005 00004	PUBLIC RECURSIVE PROCEDURE BEGINBLOCK(BOOLEAN MIDPGPH INTEGER ECASE  STRING NAME) $"#
C00007 00005	PUBLIC SIMPLE PROCEDURE ENDANY(BOOLEAN CHECK) $"#
C00009 00006	PUBLIC RECURSIVE BOOLEAN PROCEDURE ENDBLOCK $"#
C00016 00007	PUBLIC RECURSIVE PROCEDURE TOEND $"#
C00017 00008	FINISHED
C00018 ENDMK
C⊗;
BEGOF("BLOCK")

COMMENT

Block structure is implemented by various methods.  The principle
data structure is ISTK which is an integer stack of declaration
records, each linked to the record below.  An associated data
structure is SSTK, which is a string stack whose records are
referenced from corresponding entries in ISTK.

At block BEGIN, the mode-state of PUB is BLockTransferred onto ISTK
in a MODETYPE record.  Each declaration in the block causes another
record to be stacked on top.  At block END, records are peeled off
top-down, usually with the side effect of resetting global
parameters.  Finally, the MODETYPE record is unstacked, and its
contents BLockTransferred back to the mode-state.

;

PROCEDURES
PUBLIC SIMPLE PROCEDURE BLOCK! ;$"#
BEGIN "BLOCK!"
ENDCASE ← STARTS ← 0 ;
BLNMS ← -1 ;
IXEND ← LDB(IXN(<SYMNUM("END")>)) ;
END "BLOCK!" ;
PUBLIC RECURSIVE PROCEDURE BEGINBLOCK(BOOLEAN MIDPGPH; INTEGER ECASE ; STRING NAME) ;$"#
BEGIN "BEGINBLOCK"
INTEGER MIX, I, X ;
IF ECASE = 0 THEN STARTS ← STARTS + 1 comment START...END ;
ELSE IF ECASE=-1 THEN ENDCASE←1  comment, ONCE merging with BEGIN ;
ELSE	BEGIN "NOT CLUMP"
	I←ENDCASE; ENDCASE←0; DBREAK; ENDCASE←I;   RKJ: 7/15/74;
	DEPTH ← DEPTH + 1 ; MIX ← PUSHI(MODEWDS, MODETYPE) ;
	ARRBLT(ISTK[MIX-MODEWDS], BREAKM, MODEWDS) ;
	PUSHI(TABLIMIT+1, TABTYPE) ; I ← 0 ;
	DO ISTK[MIX←MIX+1] ← X ← TABSORT[I←I+1] UNTIL X>TWO(32) ;
	ISTK[MIX+1] ← ISTK[IHED] ; OLDIHED ← IHED;TES 11/15/73; IHED ← MIX + 1 ;
	IF MIDPGPH THEN
		BEGIN "SAVE FILL PARAMS"
		X ← MIDWDS + 1 ; PUSHI(X, MIDTYPE) ;
		ILBF ← CVASC(LBF) ; ARRBLT(ISTK[IHED-X], THISTYPE, X-1) ;
		ISTK[IHED-1]←PUSHS(1, THISWD) ; NOPGPH ← TRUE ; PLBL←BRKPLBL←-TWO(13) ;
		END "SAVE FILL PARAMS" ;
	ENDCASE ← ECASE ; STARTS ← 0 ;
	END "NOT CLUMP" ;
IF BLNMS=MAXBLNMS THEN WARN(NULL, "Deep block nest/possibly infinite recursion");
RKJ: 5-10-74 - added CAPITALIZE below ;
IF NAME NEQ ALTMODE THEN BLKNAMES[BLNMS←BLNMS+1] ← CAPITALIZE(NAME) ; comment not for ONCE! ;
END "BEGINBLOCK" ;
PUBLIC SIMPLE PROCEDURE ENDANY(BOOLEAN CHECK) ;$"#
BEGIN "ENDANY"
STRING BLOCKNAME ;
BLOCKNAME ← IF BLNMS<0 THEN "!MISSING!" ELSE BLKNAMES[BLNMS] ;
BLNMS ← (BLNMS MAX 0) - 1 ;
IF CHECK AND THATISCON THEN
	BEGIN
	PASS ;
	LOPP(THISWD) ;
	RKJ: 5-10-74 - added CAPITALIZE below ;
	IF NOT EQU(CAPITALIZE(THISWD),BLOCKNAME) THEN WARN("Mismatched BEGIN-END",<"BEGIN """&BLOCKNAME&""" but END """&THISWD&"""">) ;
	END
ELSE IF FULSTR(BLOCKNAME) THEN WARN("Mismatched BEGIN-END",<"BEGIN """&BLOCKNAME&""" but END <blank>">) ;
END "ENDANY" ;

PUBLIC RECURSIVE PROCEDURE ENDBEGIN ;$"#
	BEGIN ENDANY(TRUE) ; IF ENDBLOCK THEN WARN("=","Missed END in Response|Footnote") ELSE PASS END ;

PUBLIC RECURSIVE PROCEDURE ENDONCE ;$"#
	IF ENDBLOCK THEN WARN("=","Missing END in Response|Footnote") ELSE ENDBEGIN ;

PUBLIC RECURSIVE PROCEDURE ENDRESP ;$"#
	BEGIN ENDANY(TRUE) ; PASS ; IF ENDBLOCK THEN MYEND←TRUE ELSE WARN("=","Extra END") ; END ;

PUBLIC RECURSIVE PROCEDURE ENDSTART ;$"#
	BEGIN ENDANY(TRUE) ; STARTS ← STARTS - 1 ; PASS ; END ;
PUBLIC RECURSIVE BOOLEAN PROCEDURE ENDBLOCK ;$"#
IF BLNMS<0 AND LAST>2 THEN BEGIN WARN("=","Extra END ignored"); BLNMS←0; RETURN(FALSE) END ELSE
BEGIN "ENDBLOCK"
INTEGER TYP, OLD, MIX, I, X, L1, L2, PASSED, NARROWED ; STRING S ;
I←ENDCASE; ENDCASE←0; DBREAK; ENDCASE←I; RKJ: 7/11/74;
NARROWED ← PASSED ← FALSE ;
DO COMMENT Skip through ISTK restoring former state and terminating INDENT etc. ;
BEGIN "ISTK ENTRY"
TYP ← IXTYPE(IHED) ;
CASE TYP - 12 OF
BEGIN COMMENT BY TYPE ;
[AREATYPE-12]	IF  NOT DISD(IHED) THEN BEGIN CLOSEAREA(IHED,TRUE) ; NUMBER[LDB(BIXNUM(IHED))]←0 END;
[COUNTERTYPE-12]	IF  NOT DISD(IHED) THEN BEGIN CLOSECOUNTER(IHED,TRUE) ; NUMBER[LDB(BIXNUM(IHED))]←0 END;
[MACROTYPE-12]	BEGIN SSTK[BODY(IHED)]←NULL;TES 11/15/73; NUMBER[LDB(BIXNUM(IHED))] ← 0 END;
[RESPTYPE-12]	BEGIN "POP RESP"
		X ← CLUE(IHED) ; I ← VARIETY(IHED) ; OLD ← OLD!RESP(IHED) ;
		SSTK[BODY(IHED)] ← NULL ; TES 11/15/73 ;
		CASE I-1 MIN 2 OF
		BEGIN "BY VARIETY"
		COMMENT 0 ... Phrase ;
			TES 11/15/73 removed this case ;
		COMMENT 1 ... Inset ;
			IF FINDINSET(X) THEN
			IF  NOT OLD THEN LLSKIP(LEADRESPS, <NEXT!RESP>)
			ELSE	BEGIN
				NEXT!RESP(OLD) ← LLPOST ;
				IF LLPREV<0 THEN LEADRESPS←OLD ELSE NEXT!RESP(LLPREV) ← OLD ;
				END ;
		COMMENT 2 ... Signal ;
			BEGIN "SIGNAL"
			X ← SIGNAL(IHED) ; L1 ← X LSH -29 ;
			IF FINDSIGNAL(X) THEN
			IF  NOT OLD THEN	BEGIN
					S ← NULL ;
					WHILE FULSTR(SIG!BRC) AND (L2←LOP(SIG!BRC)) NEQ L1 DO S←S&L2;
					SIG!BRC ← S & SIG!BRC ;
					LLSKIP(<SIGNALD[L1]>, <NEXT!RESP>) ; COMMENT JAN 8 1973 ;
					END
			ELSE	BEGIN
				NEXT!RESP(OLD) ← LLPOST ;
				IF LLPREV<0 THEN SIGNALD[L1]←OLD ELSE NEXT!RESP(LLPREV) ← OLD ;
				END ;
			END "SIGNAL" ;
		COMMENT 3, 4 ... After, Before ;
			IF FINDTRAN(X,I) THEN
			IF  NOT OLD THEN LLSKIP(WAITRESP, <NEXT!RESP>)
			ELSE	BEGIN
				NEXT!RESP(OLD) ← LLPOST ;
				IF LLPREV<0 THEN WAITRESP←OLD ELSE NEXT!RESP(LLPREV) ← OLD ;
				END ;
		END "BY VARIETY" ;
		END "POP RESP" ;
[MARGTYPE-12]	IF OLD←AREAX(IHED) THEN
			BEGIN NARROWED ← TRUE ; MARGINS(OLD) ← X ← OLD!MARGX(IHED) ;
			LMARG ← IF X THEN LMARGX(X) ELSE 0 ;
			RMARG ← IF X THEN RMARGX(X) ELSE COLWID(OLD) ;
			END ;
[TURNTYPE-12]	IF (OLD←ISTK[IHED-1]) GEQ 0 THEN TURN(OLD LSH -7  , OLD LAND '177 , 1 ) ;
[MODETYPE-12]	BEGIN
		I ← GROUPM ; OLD ← AREAIXM ; X ← GLINEM ; TES 11/15/73 REMOVED J ← THISFONT ;
		ARRBLT(BREAKM, ISTK[IHED-MODEWDS], MODEWDS) ; OLD SWAP AREAIXM ;
		TES 11/14/73 removed IF J NEQ THISFONT THEN SELECTFONT(THISFONT);
		IF I THEN IF  NOT GROUPM THEN DAPART
			  ELSE IF GLINEM=0 THEN GLINEM ← X ;
				COMMENT ADDED THIS ↑ LINE 2/20/73 ;
		IF  NOT PASSED AND NARROWED THEN NOPGPH ← 1 ;
		JUSTIFY ← FILL AND ADJUST OR JUSTJUST ;
		PLACE(IF OLD THEN OLD ELSE IXTEXT);
		COMPMAXIMS ;
		END ;
[NUMTYPE-12]	BEGIN
		OLD ← OLD!NUMBER(IHED) ;
		NUMBER[X ← LDB(SYMBOLWD(OLD))] ← OLD ;
		IF X = SYMPAGE THEN BEGIN IXPAGE ← LDB(IXN(X)) ; PATPAGE ← PATT!STRS(IXPAGE) END
		ELSE IF X = SYMTEXT THEN IXTEXT ← LDB(IXN(X)) ;
		END ;
[TABTYPE-12]	BEGIN
		MIX ← IXOLD(IHED) ; I ← 0 ;
		DO TABSORT[I←I+1] ← X ← ISTK[MIX←MIX+1] UNTIL X>TWO(32) ;
		END ;
[MIDTYPE-12]	BEGIN
		IF LENGTH(INPUTSTR)>1 THEN WARN("Imbalance","Unbalanced Response|Footnote! "&SOMEINPUT) ;
		THISWD←SSTK[ISTK[IHED-1]] ; OLD←PLBL ;
		ARRBLT(THISTYPE,ISTK[X←IXOLD(IHED)+1],IHED-X-1) ;
 		LBF ← CVSTR(ILBF) ;
		WHILE FULSTR(LBF) AND LBF[∞ FOR 1]=0 DO LBF←LBF[1 TO ∞-1] ;
		IF OLD NEQ -TWO(13) THEN
			BEGIN COMMENT UNDEFINED PAGE LABELS -- PASS UP TO OUTER BLOCK ;
			X ← OLD ;
			DO BEGIN L1←X ; X←IF X<0 THEN NUMBER[-X] ELSE ITBL[X] END UNTIL X=-TWO(13) ;
			IF L1<0 THEN NUMBER[-L1] ← PLBL ELSE ITBL[L1] ← PLBL ;
			PLBL ← OLD ;
			END ;
		INPUTSTR←NULL ; IF THATISFULL THEN RDENTITY ELSE INPUTSTR←SWICHBACK ; PASSED←TRUE ;
		END ;
[FONTYPE-12]	IF (OLD←AREAX(IHED)) AND XCRIBL THEN TES 11/15/73 ;
			BEGIN
			FONTSIX(OLD) ← OUTERX(IHED) ;
			TFONT(OLD) ← THISFONTX(IHED) ;
			OFONT(OLD) ← OLDFONTX(IHED) ;
			IF OLD = AREAIXM THEN
				BEGIN
				THISFONT ← TFONT(OLD) ;
				OLDFONT ← OFONT(OLD) ;
				IDASSIGN(FNTFIL[THISFONT], CW) ;
				END ;
			END ;
[PITYPE-12]	PICHAR[PIKEY(IHED)] ← SSTK[PIVAL(IHED)]  TES 11/29/73;
END ; COMMENT BY TYPE ;
IHED ← IXOLD(IHED) ;
END "ISTK ENTRY"
UNTIL TYP=MODETYPE OR IHED=0 ;
DEPTH ← DEPTH - 1 ;
RETURN(PASSED) ;
END "ENDBLOCK" ;
PUBLIC RECURSIVE PROCEDURE TOEND ;$"#
	BEGIN "TOEND"
	BOOLEAN VALID ;
	VALID ← TRUE ;
	DO VALID ← CHUNK(VALID) UNTIL MYEND ;
	MYEND ← FALSE ;
	END "TOEND" ;
FINISHED

ENDOF("BLOCK")